home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / HPGL.I < prev    next >
Text File  |  1991-12-14  |  42KB  |  1,490 lines
  1. IMPLEMENTATION MODULE HPGL ;
  2.  
  3. (*
  4.    Versuch, ein bereits fertiges HPGL-File zu interpretieren
  5.    und die Objekte zu übernehmen. Quick'n Dirty-Version.
  6.    Verbesserungen überall möglich und nötig... (JP)
  7.  
  8.    Die allgemeine Syntax eines HPGL-Befehles lautet:
  9.              XX{a1{,a2{...}}}{;}
  10.    wobei XX ein zweibuchstabiges Kommando in Großschrift ist, worauf
  11.    kein, ein oder mehrere Parameter, durch Kommata voneinander ge-
  12.    trennt, folgen. Der Befehl wird durch ein ";" abgeschlossen bzw.
  13.    es folgt unmittelbar darauf der nächste Befehl.
  14.    Die Befehlsübersicht und ihre Syntax wurden der c't-Kartei 1/1990
  15.    auf S.335-342 entnommen.
  16.  
  17.    Dieses Modul ist (C)'90 by Jens Pirnay
  18. *)
  19. (*
  20.    Letzte Änderung: - 17/04/91 13:01 Änderungen bei:
  21.                       (1) PlotText      (Adresse von Cptr eingesetzt)
  22.                       (2) ComputeDirect (arctan(0) vermieden)
  23.                       (3) GetIntNumber,
  24.                           GetRealNumber (eofcmd besser gesetzt)
  25. *)
  26. FROM Dialoge         IMPORT BusyStart, BusyEnd;
  27. FROM Diverses        IMPORT min, max, round, GetFSelText, NumAlert;
  28. FROM FileIO          IMPORT Fopen, EOF, AgainChar, Reset, Close, ReadChar;
  29. FROM ObjectUtilities IMPORT FillObject;
  30. FROM Types           IMPORT DrawObjectTyp, TextPosTyp, CodeAryTyp,
  31.                             ObjectPtrTyp, ExtendedPtrTyp,
  32.                             CharArraySize, ExtendedArraySize ;
  33. FROM SYSTEM          IMPORT BYTE, WORD, ADDRESS , ADR ;
  34.  
  35. IMPORT CommonData ;
  36. IMPORT GetFile;
  37. IMPORT MathLib0 ;
  38. IMPORT MagicConvert ;
  39. IMPORT MagicDOS ;
  40. IMPORT MagicStrings ;
  41. IMPORT MagicSys ;
  42. IMPORT Variablen ;
  43. IMPORT mtAlerts;
  44. FROM VectorFont IMPORT LoadFont, TextWidth, TextHeight, SetTextStyle,
  45.                        SetFont, OutText,  CreateText;
  46. (**
  47. IMPORT Debug;
  48. IMPORT RTD;
  49. **)
  50.  
  51. CONST MaxParams         = 15; (* Sollte in jedem Falle langen             *)
  52.       MaxCommand        = 57; (* Die meisten Kommandos brauchen wir nie ! *)
  53.       CR                = 15C;
  54.       LF                = 12C;
  55.       FF                = 14C;
  56.  
  57. TYPE  ParseRec          = RECORD
  58.                             cmd    : ARRAY [0..2] OF CHAR;
  59.                             Action : PROC;
  60.                           END;
  61.       chset             = SET OF CHAR;
  62.       linetyp           = (SolidLn, DottdLn, DashdLn);
  63.  
  64.  
  65. VAR Linetype            : linetyp;
  66.     textpos             : TextPosTyp;
  67.     (* NoJust, LeftTop, Left, LeftBot, Top,
  68.        Center, Bottom, RightTop, Right, RightBot *)
  69.     Command             : ARRAY [0..2] OF CHAR;
  70.     ParamTail           : ARRAY [0..255] OF CHAR;
  71.     WholeParams         : ARRAY [0..255] OF CHAR;
  72.     StrParams           : ARRAY [1..MaxParams] OF ARRAY [0..59] OF CHAR;
  73.     Parse               : ARRAY [1..MaxCommand] OF ParseRec;
  74.     ValParams           : ARRAY [1..MaxParams] OF INTEGER;
  75.     CurrentParam        : CARDINAL;  (* gibt die Zahl der aktuellen Parameter an *)
  76.     currcmd             : CARDINAL;
  77.     currentend          : CHAR;
  78.     EndCharacter        : CHAR;
  79.     CurrentXPos         : INTEGER;
  80.     CurrentYPos         : INTEGER;
  81.     Filehandle          : INTEGER;
  82.     Filltype            : INTEGER;
  83.     P1x, P1y, P2x, P2y  : INTEGER;
  84.     ScP1x, ScP1y,
  85.     ScP2x, ScP2y        : INTEGER;  (* In User-Units *)
  86.     Thickness           : INTEGER;
  87.     writeangle          : INTEGER;
  88.     Xtxtsize, Ytxtsize  : LONGREAL;
  89.     charslant           : LONGREAL;
  90.     charheigth          : LONGREAL; (* = % von P2y - P1y *)
  91.     charwidth           : LONGREAL; (* = % von P2x - P1x *)
  92.     PenUp               : BOOLEAN;
  93.     ScaleMode           : BOOLEAN;
  94.     ThereWasAPoint      : BOOLEAN;
  95.     error               : BOOLEAN;
  96.     LineToAdd           : CodeAryTyp;
  97.  
  98. (* ----------------------------------------------------------------- *)
  99.  
  100. (* $D+*)
  101. PROCEDURE GobbleSpaces;
  102. VAR c : CHAR;
  103. BEGIN
  104.   REPEAT
  105.     ReadChar(Filehandle, c);
  106.   UNTIL EOF OR NOT (c IN chset{' ',03C,CR,LF});
  107. (**
  108.   RTD.ShowVar('Gobble now:', c);
  109. **)
  110.   AgainChar := NOT EOF;
  111. (**
  112.   RTD.Message('Leaving GobbleSpaces');
  113. **)
  114. END GobbleSpaces;
  115. (* $D-*)
  116.  
  117. (* ----------------------------------------------------------------- *)
  118.  
  119. PROCEDURE ReadCommand(VAR command : ARRAY OF CHAR);
  120. VAR result : ARRAY [0..2] OF CHAR;
  121.     last1, last2   : CHAR;
  122. BEGIN
  123.   GobbleSpaces;
  124.   result := '  ';
  125.   last1  := 0C;
  126.   last2  := 0C;
  127.   LOOP
  128.     REPEAT
  129.       last2 := last1;
  130.       last1 := result[0];
  131.       ReadChar(Filehandle, result[0]);
  132.     UNTIL EOF OR ((result[0]>='A') AND (result[0]<='Z'));
  133.   (**
  134.     RTD.ShowVar('Cmd-Char:', result[0]);
  135.   **)
  136.     error := NOT (result[0]>='A') AND (result[0]<='Z');
  137.     IF NOT EOF AND NOT error THEN
  138.       ReadChar(Filehandle, result[1]);
  139.       IF (last2=CHR(27)) AND (last1=CHR(46)) THEN
  140.         (* nur bei <1B 2E> Spezialfall *)
  141.         IF (result[1]>='A') AND (result[1]<='Z') THEN
  142.           EXIT;
  143.         END;
  144.        ELSE
  145.         EXIT;
  146.       END;
  147.      ELSE
  148.       result := '';
  149.       EXIT;
  150.     END;
  151.  
  152.   END;
  153. (**
  154.   RTD.Message(result);
  155. **)
  156.   MagicStrings.Assign(result, command);
  157. (**
  158.   RTD.Message('Leaving ReadCommand');
  159. **)
  160. END ReadCommand;
  161.  
  162. (* ----------------------------------------------------------------- *)
  163.  
  164. PROCEDURE ReadEndOfCommand;
  165. VAR c     : CHAR;
  166.     index : INTEGER;
  167.     cset  : chset;
  168. BEGIN
  169.   cset := chset{03C,CR,LF,FF,'A'..'Z'};
  170.   INCL(cset, currentend);
  171.   index := 0;
  172.   REPEAT
  173.     ReadChar(Filehandle, c);
  174.     WholeParams[index] := c;
  175.     INC(index, 1);
  176.   UNTIL EOF OR (c IN cset);
  177.   IF c IN chset{'A'..'Z'} THEN
  178.     AgainChar := TRUE;
  179.   END;
  180.   WholeParams[index] := 0C;
  181. (**
  182.   RTD.Message('EOFcomm:');
  183.   RTD.Message(WholeParams);
  184.   RTD.Message('Leaving ReadEndOfCommand');
  185. **)
  186. END ReadEndOfCommand;
  187.  
  188. (* ----------------------------------------------------------------- *)
  189.  
  190. PROCEDURE TexValueX(plotvalue : INTEGER) : INTEGER;
  191. (* Rechne die Plotter-Koordinaten in vernünftiges System um:
  192.    Plotterauflösung beträgt 0.025 mm = 1/40 mm
  193. *)
  194. VAR res  : INTEGER;
  195.     rres : LONGREAL;
  196. BEGIN
  197.   IF ScaleMode THEN
  198. (**
  199.     RTD.Message('sc-mode');
  200. **)
  201.     res := round(
  202.            MathLib0.real(P2x-P1x)/MathLib0.real(ScP2x-ScP1x)*
  203.            MathLib0.real(plotvalue-ScP1x)
  204.            ) + P1x;
  205.    ELSE
  206.     res := plotvalue;
  207.   END;
  208. (**
  209.   RTD.ShowVar('pv', plotvalue);
  210.   RTD.ShowVar('tx', res);
  211.   RTD.Message('L. TVX');
  212. **)
  213.   RETURN res;
  214. END TexValueX;
  215.  
  216. PROCEDURE TexValueY(plotvalue : INTEGER) : INTEGER;
  217. (* Rechne die Plotter-Koordinaten in vernünftiges System um:
  218.    Plotterauflösung beträgt 0.025 mm = 1/40 mm
  219. *)
  220. VAR res  : INTEGER;
  221.     rres : LONGREAL;
  222. BEGIN
  223.   IF ScaleMode THEN
  224. (**
  225.     RTD.Message('sc-mode');
  226. **)
  227.     res := round(
  228.            MathLib0.real(P2y-P1y)/MathLib0.real(ScP2y-ScP1y)*
  229.            MathLib0.real(plotvalue-ScP1y)
  230.            ) + P1y;
  231.    ELSE
  232.     res := plotvalue;
  233.   END;
  234. (**
  235.   RTD.ShowVar('pv', plotvalue);
  236.   RTD.ShowVar('ty', res);
  237.   RTD.Message('L. TVY');
  238. **)
  239.   RETURN res;
  240. END TexValueY;
  241.  
  242. (* ----------------------------------------------------------------- *)
  243.  
  244. (* $D+*)
  245. PROCEDURE GetIntNumber(VAR str    : ARRAY OF CHAR;
  246.                        VAR intval : INTEGER;
  247.                        VAR eofcmd : BOOLEAN);
  248. VAR result : ARRAY [0..127] OF CHAR;
  249.     c      : CHAR;
  250.     index  : INTEGER;
  251.     ok     : BOOLEAN;
  252. BEGIN
  253.   GobbleSpaces;
  254.   index := 0;
  255.   REPEAT
  256.     ReadChar(Filehandle, c);
  257.     result[index] := c;
  258.     INC(index, 1);
  259.   UNTIL EOF OR NOT (c IN chset{'0'..'9','+','-'});
  260.   result[index-1] := 0C;
  261.   eofcmd := (c =';') OR (c=03C) OR ((c>='A') AND (c<='Z'));
  262.   IF NOT EOF THEN
  263.     IF (c<>',') AND (c<>';') AND (c<>03C) THEN
  264.       AgainChar := TRUE;
  265.     END;
  266. (**
  267.    ELSE
  268.     eofcmd := TRUE;
  269. **)
  270.   END;
  271.   MagicStrings.Assign(result, str);
  272.   intval := MagicConvert.StrToInt(str);
  273. (**
  274.   RTD.ShowVar('IntVal :', intval);
  275.   RTD.Message(result);
  276.   RTD.Message('Leaving GetIntNumber');
  277. **)
  278. END GetIntNumber;
  279. (* $D-*)
  280.  
  281. PROCEDURE GetRealNumber(VAR str     : ARRAY OF CHAR;
  282.                         VAR realval : LONGREAL;
  283.                         VAR eofcmd  : BOOLEAN);
  284. VAR re